home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples2.0.Lha / Examples / Talk2Boopsi / talk2boopsi.bas < prev   
Encoding:
BASIC Source File  |  1994-04-15  |  7.3 KB  |  219 lines
  1.  
  2. '' talk2boopsi.bas
  3. ''
  4. '' Simple example of Boopsi prop gadget and integer string gadget, connecting them so
  5. '' they update each other when the user changes their value. This has been extended
  6. '' to include two buttons and to indicate which has been selected.
  7. ''
  8. '' Derived from RKM example (c) Copyright 1992 Commodore-Amiga, Inc.
  9. ''
  10. DEFINT a-z
  11. 'REM $include intuition.bh
  12. 'REM $include exec.bh
  13. 'REM $include utility.bc
  14. LIBRARY OPEN "intuition.library",37
  15. LIBRARY OPEN "exec.library"
  16. mysc& = LockPubScreen(0)
  17. IF mysc&=0 THEN
  18.     PRINT "Couldn't lock public screen"
  19. ELSE
  20.     drawinfo&=GetScreenDrawInfo&(mysc&)
  21.        IF drawinfo& THEN 
  22.  
  23.  
  24.  
  25. ' The attribute mapping lists
  26. ' This tells the prop gadget to  map its PGA_Top attribute to
  27. ' STRINGA_LongVal when it issues an update about the change TO its PGA_Top value.
  28.  
  29. DIM prop2intmap&(6)
  30. TAGLIST VARPTR(prop2intmap&(0)), _
  31.     PGA_Top&,   STRINGA_LongVal&, _
  32.     TAG_END& 
  33.  
  34. ' This tells the string gadget to map its STRINGA_LongVal
  35.  
  36. DIM int2propmap&(6)
  37. TAGLIST VARPTR(int2propmap&(0)), _
  38.      STRINGA_LongVal&, PGA_Top&,  _
  39.     TAG_END& 
  40.  
  41. CONST PROPGADGET_ID&=1
  42. CONST INTGADGET_ID&=2
  43. CONST OKFRAMEGADGET_ID&=3
  44. CONST OKTEXTGADGET_ID&=4
  45. CONST CANCELTEXTGADGET_ID&=5
  46.  
  47.  
  48. CONST PROPGADGETWIDTH&=10
  49. CONST PROPGADGETHEIGHT&=80
  50. CONST INTGADGETHEIGHT&=18
  51. CONST VISIBLE&=10
  52. CONST TOTAL&=100
  53. CONST INITIALVAL&=25
  54. CONST MINWINDOWWIDTH&=80
  55. CONST MINWINDOWHEIGHT& =150 '    (PROPGADGETHEIGHT + 70)
  56. CONST MAXCHARS& = 5
  57.  
  58. junk&=ModifyIDCMP(WINDOW(7),IDCMP_CLOSEWINDOW&+IDCMP_GADGETUP&+IDCMP_RAWKEY&)
  59.  ' Create a new propgclass object
  60. DIM    propgadlist&(20)
  61. TAGLIST  VARPTR(propgadlist&(0)), _
  62.                 GA_ID&,     PROPGADGET_ID&, _       ' These are defined by gadgetclass AND        
  63.                 GA_Top&,    PEEKB(WINDOW(7)+BorderTop) + 5, _ ' correspond TO similarly named fields in     
  64.                 GA_Left&,   PEEKB(WINDOW(7)+BorderLeft) + 5, _ ' the Gadget structure.                       
  65.                 GA_Width&,  PROPGADGETWIDTH&, _
  66.                 GA_Height&, PROPGADGETHEIGHT&, _
  67.                 ICA_MAP&,      VARPTR(prop2intmap&(0)), _' The prop gadget's attribute map 
  68. _             ' The rest of this gadget's attributes are defined by propgclass. 
  69.                 PGA_Total&,     TOTAL&, _    ' This is the integer range of the prop gadget. 
  70.                 PGA_Top&,       INITIALVAL&, _ ' The initial integer value of the prop gadget. 
  71. _
  72.                 PGA_Visible&,   VISIBLE&, _ ' This determines how much of the prop gadget area is  
  73. _                                        ''covered by the prop gadget's knob, or how much of    
  74. _                                        ' the gadget's TOTAL range is taken up by the prop     
  75. _                                        'gadget's knob.                                       
  76.                 PGA_NewLook&,   1&, _    ' Use new-look prop gadget imagery
  77.                 TAG_END&
  78.  
  79.     PropGadget& = NewObjectA&(0, SADD("propgclass"+CHR$(0)),VARPTR(propgadlist&(0)))
  80.     IF PropGadget& THEN
  81.  
  82. ' create the integer string gadget.                    
  83.  
  84. ' The GA_Previous attribute is defined by gadgetclass and is used to
  85. ' wedge a new gadget into a list of gadget's linked by their       
  86. ' Gadget.NextGadget field.  When NewObject() creates this gadget,  
  87. ' it inserts the new gadget into this list behind the GA_Previous  
  88. ' gadget. This attribute is a pointer to the previous gadget       
  89. ' This attribute cannot be used to link new    
  90. ' gadgets into the gadget list of an open window or requester,      
  91. ' use AddGlist instead
  92.  DIM Strgadlist&(20) 
  93. TAGLIST VARPTR(strgadlist&(0)), _ 
  94.     GA_ID&,            INTGADGET_ID&, _ ' Parameters for the Gadget structure
  95.     GA_Top&,        PEEKB(WINDOW(7)+BorderTop) + 5, _
  96.     GA_Left&,        PEEKB(WINDOW(7)+BorderLeft) + PROPGADGETWIDTH& + 10, _
  97.     GA_Width&,        MINWINDOWWIDTH& -( PEEKB(WINDOW(7)+BorderLeft) +PEEKB(WINDOW(7)+BorderRight) + PROPGADGETWIDTH + 15), _
  98.     GA_Height&,        INTGADGETHEIGHT&, _
  99.     ICA_MAP&,        VARPTR(int2propmap&(0)), _ ' The attribute map
  100.     ICA_TARGET&,    PropGadget&, _     ' plus the target.
  101.     GA_Previous&,    PropGadget&, _
  102.     STRINGA_LongVal&,INITIALVAL&, _
  103.     STRINGA_MaxChars&, MAXCHARS&, _
  104.     TAG_END&
  105.  
  106.    IntegerGadget& = NewObjectA&(0,SADD( "strgclass"+CHR$(0)),VARPTR(strgadlist&(0)))
  107.  
  108.     IF IntegerGadget& THEN
  109.  
  110. ' Now we will have a frame that will draw round our buttons
  111.     
  112. TAGLIST VARPTR(strgadlist&(0)), _ 
  113.     GA_ID&,            OKFRAMEGADGET_ID&, _ ' Parameters for the Gadget structure
  114.     TAG_END&
  115.  
  116.    OKFrameGadget& = NewObjectA&(0,SADD( "frameiclass"+CHR$(0)),VARPTR(strgadlist&(0)))
  117.  
  118. ' Now lets have our OK gadget 
  119.  
  120. TAGLIST VARPTR(strgadlist&(0)), _ 
  121.     GA_ID&,            OKTEXTGADGET_ID&, _ ' Parameters for the Gadget structure
  122.     GA_Top&,        PEEKB(WINDOW(7)+BorderTop) + 5, _
  123.     GA_Left&,        PEEKB(WINDOW(7)+BorderLeft) + PROPGADGETWIDTH& + 60, _
  124.         GA_Immediate&, 1&, _
  125.         GA_RelVerify&, 1&, _
  126.         GA_DrawInfo&,    drawinfo&, _
  127.     GA_Text&,     "OK", _
  128.     GA_Image&,    OKFrameGadget&, _
  129.     GA_Previous&,    IntegerGadget&, _
  130.         TAG_END&
  131.  
  132.    OKGadget& = NewObjectA&(0,SADD( "frbuttonclass"+CHR$(0)),VARPTR(strgadlist&(0)))
  133.  
  134. ' Now lets have our Cancel gadget 
  135.  
  136. TAGLIST VARPTR(strgadlist&(0)), _ 
  137.     GA_ID&,            CANCELTEXTGADGET_ID&, _ ' Parameters for the Gadget structure
  138.     GA_Top&,        PEEKB(WINDOW(7)+BorderTop) + 35, _
  139.     GA_Left&,        PEEKB(WINDOW(7)+BorderLeft) + PROPGADGETWIDTH& + 60, _
  140.         GA_Immediate&, 1&, _
  141.         GA_RelVerify&, 1&, _
  142.         GA_DrawInfo&,    drawinfo&, _
  143.     GA_Text&,     "Cancel", _
  144.     GA_Image&,    OKFrameGadget&, _
  145.     GA_Previous&,    OKGadget&, _
  146.         TAG_END&
  147.  
  148.    CancelGadget& = NewObjectA&(0,SADD( "frbuttonclass"+CHR$(0)),VARPTR(strgadlist&(0)))
  149.  
  150. DIM temp&(4)
  151. ' Because the integer string gadget did NOT
  152. ' exist when this example created the prop
  153. ' gadget, it had to wait to set the
  154. ' ICA_TARGET of the prop gadget.
  155.  
  156.     TAGLIST VARPTR(temp&(0)), ICA_TARGET&, IntegerGadget&, TAG_END&
  157.     junk&=SetGadgetAttrsA&(PropGadget&, WINDOW(7),0, VARPTR(temp&(0)))
  158.  
  159. ' Now lets make the buttons nice and wide, since the defaults are rather small.
  160.     TAGLIST VARPTR(temp&(0)), GA_WIDTH&, 100, TAG_END&
  161.         junk&=SetGadgetAttrsA&(CancelGadget&, WINDOW(7),0, VARPTR(temp&(0)))
  162.        junk&=SetGadgetAttrsA&(OKGadget&, WINDOW(7),0, VARPTR(temp&(0)))
  163.  
  164.  
  165.         junk&= AddGList(WINDOW(7),PropGadget&,-1,-1,0)  ' Add the gadgets to the                 
  166.         RefreshGList propGadget&, WINDOW(7), 0, -1     ' window and display them.               
  167.     HandleEvents
  168.        junk&=RemoveGList(WINDOW(7), PropGadget&, -1)
  169.        DisposeObject IntegerGadget&
  170.       END IF 
  171.       DisposeObject PropGadget& 
  172.      END IF
  173.  
  174.         FreeScreenDrawInfo mysc&,drawinfo&
  175.         END IF
  176.         UnlockPubScreen 0, mysc&
  177. END IF
  178.  
  179. 'STOP -1
  180.  
  181. SUB HandleEvents
  182. STATIC junk&,imsg&,g&,cl&,id,sliderval&
  183. SHARED integergadget&
  184.  ' Wait for the user to click
  185. '$event off
  186. DO 
  187.     junk&=    WaitPort(PEEKL(WINDOW(7)+UserPort))
  188.     DO
  189.          imsg& =GetMsg(PEEKL(WINDOW(7)+UserPort ))
  190.          IF imsg& THEN
  191.              cl&=PEEKL(imsg&+Class)
  192.              SELECT CASE cl&
  193.              CASE IDCMP_CLOSEWINDOW&
  194.                  PRINT "closing window"
  195.                  ReplyMsg imsg& 
  196.                  EXIT SUB
  197.             CASE IDCMP_GADGETUP&
  198.                 g&=PEEKL(imsg&+IAddress)
  199.                 id=PEEKW(g&+GadgetGadgetID)
  200.                 SELECT CASE id
  201.                 CASE OKTEXTGADGET_ID&:
  202.                     PRINT "OK selected slider set to";
  203.                         junk&=GetAttr&( STRINGA_LongVal&, IntegerGadget&,VARPTR(sliderval&))
  204.                         PRINT sliderval&
  205.                 CASE CANCELTEXTGADGET_ID&:
  206.                     PRINT "Cancelled"
  207.                 END SELECT
  208.                 EXIT SUB
  209.             CASE REMAINDER
  210. '                PRINT "class:"; cl&
  211.             END SELECT
  212.              ReplyMsg imsg& 
  213.         END IF
  214.     LOOP
  215. LOOP
  216. END SUB
  217.         
  218.   
  219.